Ready to Use 101 Powerful Excel VBA Code: Just Copy - Paste - Run (For Functional Users) by Anil Nahar

Author:Anil Nahar [Nahar, Anil]
Language: eng
Format: epub
Published: 2017-12-09T23:00:00+00:00

Import Multiple Text Files

Sub MulipleTextFiles()

'SmartCode for Insert Multiple text file in Seoarate worksheets

'SmartExcel(www.anilnahar.com)

Dim xFilesToOpen As Variant

Dim I As Integer

Dim xWb As Workbook

Dim xTempWb As Workbook

Dim xDelimiter As String

Dim xScreen As Boolean

On Error GoTo ErrHandler

xScreen = Application.ScreenUpdating

Application.ScreenUpdating = False

xDelimiter = "|"

xFilesToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Smart Excel", , True)

If TypeName(xFilesToOpen) = "Boolean" Then

MsgBox "No files were selected", , "Smart Excel"

GoTo ExitHandler

End If

I = 1

Set xTempWb = Workbooks.Open(xFilesToOpen(I))

xTempWb.Sheets(1).Copy

Set xWb = Application.ActiveWorkbook

xTempWb.Close False

xWb.Worksheets(I).Columns("A:A").TextToColumns _

Destination:=Range("A1"), DataType:=xlDelimited, _

TextQualifier:=xlDoubleQuote, _

ConsecutiveDelimiter:=False, _

Tab:=False, Semicolon:=False, _

Comma:=False, Space:=False, _

Other:=True, OtherChar:="|"

Do While I < UBound(xFilesToOpen)

I = I + 1

Set xTempWb = Workbooks.Open(xFilesToOpen(I))

With xWb

xTempWb.Sheets(1).Move after:=.Sheets(.Sheets.Count)

.Worksheets(I).Columns("A:A").TextToColumns _

Destination:=Range("A1"), DataType:=xlDelimited, _

TextQualifier:=xlDoubleQuote, _

ConsecutiveDelimiter:=False, _

Tab:=False, Semicolon:=False, _

Comma:=False, Space:=False, _

Other:=True, OtherChar:=xDelimiter

End With

Loop

ExitHandler:

Application.ScreenUpdating = xScreen

Set xWb = Nothing

Set xTempWb = Nothing

Exit Sub

ErrHandler:

MsgBox Err.Description, , "SmartExcel(www.anilnahar.com)"

Resume ExitHandler

End Sub

Download

Copyright Disclaimer:
This site does not store any files on its server. We only index and link to content provided by other sites. Please contact the content providers to delete copyright contents if any and email us, we'll remove relevant links or contents immediately.